Source data: https://www.dhs.wisconsin.gov/covid-19/data-101.htm, which updates at 2 PM CT daily.
Risk level colors from https://globalepidemics.org/key-metrics-for-covid-suppression/. The 7-day rolling average is plotted as a black line. Daily new cases are plotted as gray columns.
Positive test ratio is the percentage of total reported tests for each 7-day rolling period that are positive.
---
title: "La Crosse County COVID-19 Data"
date: "`r format(Sys.time(), '%B %d, %Y')`"
output:
flexdashboard::flex_dashboard:
orientation: rows
vertical_layout: scroll
source_code: embed
---
Source data: , which updates at 2 PM CT daily.
```{r setup, include=FALSE}
knitr::opts_chunk$set(
echo = FALSE,
message = FALSE,
warning = FALSE
)
library(tidyverse)
library(jsonlite)
library(lubridate)
library(httr)
library(scales)
library(plotly)
library(flexdashboard)
```
```{r importData, echo = FALSE}
COVID_WI <- read_csv("https://opendata.arcgis.com/datasets/b913e9591eae4912b33dc5b4e88646c5_10.csv?outSR=%7B%22latestWkid%22%3A3857%2C%22wkid%22%3A102100%7D")
COVID_WI <- COVID_WI %>%
arrange(DATE)
COVID_WI$DATE <- as.Date(COVID_WI$DATE)
```
```{r la_crosse_calcs, echo = FALSE}
COVID_LaCrosse <- COVID_WI %>%
filter(NAME %in% "La Crosse")
COVID_LaCrosse <- COVID_LaCrosse %>%
mutate(new_daily_avg_7 =
(lag(POS_NEW, n = 3) +
lag(POS_NEW, n = 2) +
lag(POS_NEW, n = 1) +
POS_NEW +
lead(POS_NEW, n = 1) +
lead(POS_NEW, n = 2) +
lead(POS_NEW, n = 3)) / 7)
la_crosse_pop <- 118016
# calculate positive test ratio from 7-day rolling average of new cases
COVID_LaCrosse <- COVID_LaCrosse %>%
mutate(daily_pos_avg_7 =
(lag(POS_NEW, n = 3) +
lag(POS_NEW, n = 2) +
lag(POS_NEW, n = 1) +
POS_NEW +
lead(POS_NEW, n = 1) +
lead(POS_NEW, n = 2) +
lead(POS_NEW, n = 3)) /
(lag(TEST_NEW, n = 3) +
lag(TEST_NEW, n = 2) +
lag(TEST_NEW, n = 1) +
TEST_NEW +
lead(TEST_NEW, n = 1) +
lead(TEST_NEW, n = 2) +
lead(TEST_NEW, n = 3)) * 100)
```
La Crosse County
=================================================
Row
---------------------------------------------------
### New Daily Cases per 100K population
```{r la_crosse_plot, echo = FALSE}
# plot timeline of new daily cases per 100k residents, with thresholds for green / yellow / orange / red as defined by: https://globalepidemics.org/key-metrics-for-covid-suppression/
min_date <- min(COVID_LaCrosse$DATE)
max_date <- max(COVID_LaCrosse$DATE)
max_lacrosse <- max(COVID_LaCrosse$POS_NEW, na.rm = TRUE) / la_crosse_pop * 100000
la_crosse_plot <- ggplot(COVID_LaCrosse,
aes(x = DATE, y = new_daily_avg_7 / la_crosse_pop * 100000)) +
annotate("rect", xmin = min_date, xmax = max_date, ymin = 10, ymax = 25, fill = "orange",
alpha = .5) +
annotate("rect", xmin = min_date, xmax = max_date, ymin = 1, ymax = 10, fill = "yellow",
alpha = .5) +
annotate("rect", xmin = min_date, xmax = max_date, ymin = 25,
ymax = max_lacrosse + 5, fill = "red",
alpha = .5) +
annotate("rect", xmin = min_date, xmax = max_date, ymin = 0, ymax = 1, fill = "green",
alpha = .5) +
geom_col(aes(y = POS_NEW / la_crosse_pop * 100000), fill = "gray80",
na.rm = TRUE) +
geom_line(color = "black", na.rm = TRUE) +
scale_y_continuous(limits = c(0, NA),
expand = c(0, 0)) +
scale_x_date(date_breaks = "1 month", date_labels = "%b %d",
expand = c(0, 0)) +
xlab("Date") +
ylab("Daily Cases per 100k Pop") +
theme_light(base_size = 15) +
theme(panel.grid = element_line(color = "gray95"))
la_crosse_plotly <- ggplotly(p = (la_crosse_plot))
la_crosse_plotly
```
> Risk level colors from